home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Jörg's Folder / IOTask.asm.4th < prev    next >
Encoding:
Text File  |  1992-11-04  |  36.1 KB  |  1,487 lines  |  [TEXT/NISI]
  1. \ v2.14 IOTASK
  2. \ Release 8/21/88
  3.  
  4. \ v2.14 Fixed problems with empty menubar code in (RUN-DRAG) and (RUN-CONTENT) and
  5. \ altered HandleDialog to use EVENT-RECORD message on Activate and Update events.
  6. \ Altered (RUN-DRAG) to correctly handle command-key drags.
  7.  
  8. \ I/O Task High Level Code
  9. \ Copyright 1987-1988 Palo Alto Shipping Company
  10.  
  11.  
  12. \ ========================================================================
  13. \ ========================================================================
  14. \ ========================================================================
  15.  
  16. \ Well here it is !
  17. \ The I/O Task Revealed:
  18.  
  19. \ The I/O task is the task in the Mach2 environment which handles all 
  20. \ I/O for the Mach2 task and all user created tasks.  Since I/O on the
  21. \ Macintosh involves the handling of events, the "I/O task" in Mach2 is
  22. \ really the same as the "event loop" which lies at the heart of all
  23. \ Macintosh applications.
  24.  
  25. \ The I/O task has been brought out from the dark, mysterious
  26. \ depths of the Mach2 kernel.   The Forth level source is available for
  27. \ study and soon, you will be able to create your own customized I/O
  28. \ task and install it in Mach2 in place of the default I/O task.
  29.  
  30.     \ Note: You have always been able to override
  31.     \ individual event-handling routines with the
  32.     \ use of the user variable/event vectoring mechanism.
  33.     \ The ability to substitute a completely new I/O
  34.     \ task gives you even more control over event
  35.     \ response in your application.
  36.  
  37. \ This file contains the source to the default I/O task which is
  38. \ used by Mach2.  The original I/O task code was written in assembly
  39. \ language.  The I/O task source in this file is the assembly->Forth
  40. \ translation of the original I/O task.
  41.  
  42. \ A new utility word called  NEW-IOTASK  is being added to the FORTH
  43. \ vocabulary.  The  NEW-IOTASK  utility will allow you to substitute your
  44. \ own version of the I/O task in place of the default version.
  45.  
  46. \ The use of  NEW-IOTASK  will be similar to the use of  NEW-SEGMENT  .
  47. \ You will load your new I/O task code and then execute  NEW-IOTASK.
  48. \ NEW-IOTASK will remove the current I/O task code segment (#2).
  49. \ All code in the current user code segment will be incorporated into 
  50. \ the new I/O task code segment.
  51.  
  52. \ A successful replacement I/O task must include the following routines
  53. \ (they must have these names):
  54.  
  55. \     (IOTASK)
  56. \     (EVENT-TABLE)
  57. \     (HandleEvent)
  58. \     (HandleDialog)
  59. \     (IOTASK)
  60. \     (CHECK-CONTROL)
  61. \     (RUN-CONTENT)
  62. \     (RUN-GROWBOX)
  63. \     (RUN-DRAG)
  64. \     (RUN-CLOSEBOX)
  65. \     (RUN-ZOOMIN)
  66. \     (RUN-ZOOMOUT)
  67. \     (RUN-ACTIVATE)
  68. \     (RUN-UPDATE)
  69.     
  70. \ When NEW-IOTASK is executed it will check to make sure all of the
  71. \ above dictionary entries exist.  If any are missing,  NEW-IOTASK  will
  72. \ abort.
  73.  
  74.  
  75. \ ========================================================================
  76. \ ========================================================================
  77. \ ========================================================================
  78.  
  79. \ Technical note:  To avoid using global variables, local
  80. \ variables have been used to hold rectangle data.  Since
  81. \ a local variable can hold only 4 bytes of information,
  82. \ two successive local variables were required to hold a
  83. \ complete rectange record (2 bytes each for the top, left,
  84. \ bottom, and right coordinates).  An example of this use
  85. \ of local variables is found in the (RUN-GROWBOX) routine:
  86.  
  87. \ : (RUN-GROWBOX) {  | wptr rightbot lefttop newwidth newheight --  }
  88.  
  89. \ In this routine, "rightbot" and "lefttop" are used to
  90. \ hold rectangle information. To place a rectangle record in
  91. \ these local variables the following phrase is used:
  92.  
  93. \        ScreenRect ^ lefttop 8 CMOVE
  94.  
  95. \ "ScreenRect" returns the address of a rectangle record,
  96. \ "^ lefttop" returns the start address of an 8-byte area
  97. \ in the local variable stack frame which is to be used to
  98. \ hold the rectangle record, and "8 CMOVE" moves the 
  99. \ rectangle record into the local variable area.
  100.  
  101. \ When local variable space is allocated, the storage space
  102. \ for the rightmost local variables in the local variable list
  103. \ will be located lower in memory than the storage spaces for
  104. \ the leftmost local variables.
  105.  
  106.  
  107. \ ========================================================================
  108. \ ========================================================================
  109. \ ========================================================================
  110. CR .( Loading new I/O task code...) CR
  111.  
  112. ONLY MAC
  113. ALSO DEVELOPMENT
  114. ALSO ASSEMBLER
  115. ALSO FORTH DEFINITIONS
  116.  
  117.  
  118. \ ===== Miscellaneous Constants ==========================================
  119. HEX
  120.  
  121. 1    CONSTANT .TRUE.
  122. 0    CONSTANT .FALSE.
  123.  
  124. FFFFFF86 CONSTANT screenBits    \ Offset to global Quickdraw variable which
  125.                                 \ holds the address of a bitmap record which
  126.                                 \ describes the screen currently in use.
  127. 6     CONSTANT screenBounds        \ Offset into a bitmap record to the bounding
  128.                                 \ rectangle information.
  129. 08     CONSTANT portBounds        \ Offset to bounding box of screen bitmap.
  130. 00640064 CONSTANT DiskPt
  131. 1     CONSTANT ActivateMask
  132. 100     CONSTANT CommandKeyMask
  133. FFFFFFFF CONSTANT EveryEvent    \ Recognize every event.
  134.  
  135. 10     CONSTANT portRect            \ Offset to window rect in grafport.
  136. 6C     CONSTANT windowKind        \ Window type field [word].
  137. 8C     CONSTANT controlList        \ Offset to control list in a window record.
  138. 90     CONSTANT nextWindow        \ Next window in Z-ordered list.
  139. 9C     CONSTANT GrowFlagOffset    \ Offset to Mach2 "Does this window
  140.                                 \ have a growbox?" flag located past the
  141.                                 \ end of a window record.
  142. 9E     CONSTANT VBarOffset        \ A Mach2-generated window with a V- or
  143. A2     CONSTANT HBarOffset        \ H-SCROLLBAR will have either the handle
  144.                                 \ to the scrollbar or a 0 at these offsets
  145.                                 \ to locations just past the end of a
  146.                                 \ window record.
  147. 08     CONSTANT CtrlRectOffset    \ Offset in a Mac control record to
  148.                                 \ bounding rectangle for the control.
  149.     
  150. DECIMAL
  151. 2    CONSTANT dialogKind
  152. 11    CONSTANT PatBic
  153. 129    CONSTANT InThumb
  154.  
  155.  
  156. \ ===== Mach2 Private Global Variables ===================================
  157. HEX
  158.  
  159. : EditHandle (  - a )    \ Address where handle to "Edit" menu
  160.     NP 14 +                \ is stored.
  161.     ;
  162.     
  163. : EmptyMenuBar ( - a )        \ Address where handle to an empty
  164.     EVENT-RECORD 1E +        \ menu is stored.
  165.     ;
  166.     
  167.  
  168. \ ===== EVENT-RECORD Offsets =============================================
  169. DECIMAL
  170.  
  171.  0 CONSTANT What
  172.  2 CONSTANT Message
  173.  6 CONSTANT When
  174. 10 CONSTANT Where
  175. 14 CONSTANT Modifiers
  176. 16 CONSTANT WhichWindow
  177.  
  178.  
  179. \ ===== Event Codes ======================================================
  180. DECIMAL
  181.  
  182.  0 CONSTANT Null
  183.  1 CONSTANT MouseDown
  184.  2 CONSTANT MouseUp
  185.  3 CONSTANT KeyDown
  186.  4 CONSTANT KeyUp
  187.  5 CONSTANT AutoKey
  188.  6 CONSTANT UpdateEvent
  189.  7 CONSTANT DiskInserted
  190.  8 CONSTANT ActivateEvent
  191.  
  192.  
  193. \ ===== "FindWindow" result codes ========================================
  194. DECIMAL
  195.  
  196.  0 CONSTANT InDesk
  197.  1 CONSTANT InMenuBar
  198.  2 CONSTANT InSysWindow
  199.  3 CONSTANT InContent
  200.  4 CONSTANT InDrag
  201.  5 CONSTANT InGrow
  202.  6 CONSTANT InGoAway
  203.  7 CONSTANT InZoomIn
  204.  8 CONSTANT InZoomOut
  205.  
  206.  
  207. \ ===== User variable offsets ============================================
  208. DECIMAL
  209.  
  210.  40 CONSTANT HeadOffset    
  211.  44 CONSTANT TailOffset
  212.  
  213. 72    CONSTANT TaskWindowPointerOffset
  214. 108 CONSTANT TaskMenuBarOffset
  215. 116 CONSTANT MenuDataOffset
  216. 124 CONSTANT ControlDataOffset
  217. 128 CONSTANT ControlHandleOffset
  218. 136 CONSTANT DialogDataOffset
  219. 140 CONSTANT DialogHandleOffset
  220.  
  221. 152 CONSTANT ContentOffset
  222. 156 CONSTANT DragOffset
  223. 160 CONSTANT GrowOffset
  224. 164 CONSTANT GoAwayOffset
  225. 168 CONSTANT UpdateOffset
  226. 172 CONSTANT ActivateOffset
  227. 190 CONSTANT DialogHookOffset
  228. 194 CONSTANT ZoomInOffset
  229. 198 CONSTANT ZoomOutOffset
  230. 202 CONSTANT ControlActionOffset
  231.  
  232. \ ===== MultiFinder Constants ============================================
  233.  
  234. 220    USER Next.Event.proc    \ holds the vector for the Event proc
  235. 224    USER #.of.Null.Events    \ word value to meter the number of Null Events
  236. 226    USER fgnd.bkgnd            \ flag for Mach2 in foreground/background
  237.  
  238. \ Suspend/Resume constants
  239.  
  240. 1        CONSTANT Resume        \ bit zero of EVENT-RECORD.what
  241.  
  242.  
  243. \ ===== Start of Code ====================================================
  244. \ ========================================================================
  245. \ ========================================================================
  246.  
  247.  
  248. \ ===== Utility Word =====================================================
  249.  
  250. CODE ScreenRect (  -  rectaddr )
  251.     MOVE.L    (A5),A0
  252.     LEA    screenBits(A0),A0
  253.     LEA    screenBounds(A0),A0
  254.     MOVE.L    A0,-(A6)
  255.     RTS
  256. END-CODE
  257.  
  258.  
  259. \ ===== "Non-Vectorable" Default Event Handling Routines =================
  260.  
  261. : Run-Desk (  -  )   ;
  262.  
  263. ( : Run-System (  -  )
  264.     ( we need to watch out here - if the click is in an inactive system
  265.       window and the OPERATOR window is active, we need to re-enable the
  266.       Edit Menu here. )
  267.  
  268.     CALL FrontWindow            ( -- wptr )
  269.     OPERATOR @ [ 2 TaskWindowPointerOffset + ] LITERAL + @ =
  270.     IF
  271.         EditHandle @ 
  272.         ?DUP 0= NOT
  273.         IF
  274.             ( -- edithandle )
  275.             0 CALL EnableItem
  276.             CALL DrawMenuBar
  277.         THEN
  278.     THEN
  279.  
  280.     EVENT-RECORD
  281.     EVENT-RECORD WhichWindow + @
  282.     CALL SystemClick
  283.     ; )
  284.  
  285. CODE Run-System
  286.     EXG.L    D4,A7            \ switch to trap stack
  287.     SUBQ.L    #4,A7            \ clear space for result
  288.             _FrontWindow    \ is the frontwindow the OPERATOR
  289.     MOVE.L    (A7)+,-(A6)
  290.  
  291.     MOVEA.L    OPERATOR,A0        \ get the status address
  292.     MOVE.L    2+TaskWindowPointerOffset(A0),-(A6)    \ get the OPERATOR Window
  293.  
  294.     CMPM.L    (A6)+,(A6)+        \ is the FrontWindow the OPERATOR
  295.     BNE.S    @callClick        \ branch if not
  296.     
  297.     LEA        NP,A0
  298.     MOVE.L    14(A0),D0        \ get the EditHandle Edit Menu Handle
  299.     TST.L    D0                \ check to be sure it is a handle
  300.     BEQ.S    @callClick
  301.  
  302.     MOVE.L    D0,-(A7)        \ push the EditHandle
  303.     CLR.W    -(A7)            \ Enable entire Menu
  304.             _EnableItem        \ enable the menu
  305.             _DrawMenuBar    \ update on the screen
  306.  
  307. @callClick
  308.     LEA        "EVENT-RECORD",A0        \ get the event-record
  309.     MOVE.L    A0,-(A7)                \ push it
  310.     MOVE.L    WhichWindow(A0),-(A7)    \ get the window pointer
  311.             _SystemClick            \ let the system handle the event
  312.     EXG.L    D4,A7                    \ switch back to task stack
  313.     RTS
  314. END-CODE
  315.  
  316.  
  317. \ ===== Processing Menu Selections =======================================
  318.  
  319. : Run-Menubar {  | menudata wptr taskptr flag -- }
  320.     EVENT-RECORD Where + @ CALL MenuSelect -> menudata
  321.  
  322.     \ MenuSelect will return zero in the high order word
  323.     \ if no choice is made.
  324.     ^ menudata W@
  325.     IF
  326.         CALL FrontWindow -> wptr
  327.  
  328.         BEGIN
  329.             \ What kind of window is frontmost ?
  330.             \ If it's a system window (a desk accessory window)
  331.             \ look backwards through the linked list of windows
  332.             \ for a window which belongs to a terminal task.
  333.             wptr windowKind + W@ L_EXT 0<
  334.  
  335.             \ Also make sure we haven't reached the end
  336.             \ of the window list.
  337.             wptr 0 <>
  338.             AND
  339.         WHILE
  340.             wptr nextWindow + @ -> wptr
  341.         REPEAT
  342.         
  343.         \ Once we've found a valid window, one with a
  344.         \ window kind greater than zero, we must make
  345.         \ sure it is a terminal window.
  346.         wptr CALL GetWRefCon -> taskptr
  347.         taskptr
  348.         IF
  349.             \ If it is a terminal window we can
  350.             \ send it the menu selection information.
  351.             menudata taskptr MenuDataOffset + !
  352.         THEN
  353.     THEN
  354.     ;
  355.  
  356. ( CODE Run-MenuBar
  357.     LEA        EVENT-RECORD,A0
  358.     EXG.L    D4,A7
  359.     MOVEQ.L    #0,-(A7)
  360.     MOVE.L    Where(A0),-(A7)
  361.             _MenuSelect
  362.     MOVE.L    (A7)+,-(A6)
  363.     EXG.L    D4,A7
  364.     
  365.     TST.W    (A6)
  366.     BEQ.S    @getout
  367.     
  368. @getout
  369.     RTS
  370. END-CODE )
  371.  
  372. ( : DoMenuKey {  | menudata wptr taskptr flag -- flag }
  373.     0 -> flag
  374.     EVENT-RECORD Message + 2+ W@ CALL MenuKey -> menudata
  375.     ^ menudata W@
  376.     IF
  377.         CALL FrontWindow -> wptr
  378.         wptr
  379.         IF
  380.             wptr CALL GetWRefCon -> taskptr
  381.             taskptr
  382.             IF
  383.                 taskptr TaskMenuBarOffset + @
  384.                 IF
  385.                     menudata taskptr MenuDataOffset + !
  386.                     -1 -> flag
  387.                 THEN
  388.             THEN
  389.         THEN
  390.     THEN
  391.     flag
  392.     ; )
  393.  
  394. CODE DoMenuKey
  395.     LINK    A2,#$-C
  396.     MOVEQ.L    #0,D0            \ store a false flag in menuFlag
  397.     MOVE.L    D0,$-C(A2)
  398.  
  399.     EXG.L    D4,A7
  400.     MOVE.L    D0,-(A7)        \ allocate space for result
  401.     MOVE.W    "EVENT-RECORD"+2+Message(A5),-(A7)    \ get keyStroke
  402.             _MenuKey
  403.     MOVE.L    (A7)+,$-4(A2)    \ store result
  404.     
  405.     MOVE.W    $-4(A2),D0        \ get menukey result
  406.     BEQ.S    @exitthis
  407.  
  408.     \ the key stroke was a menu key stroke
  409.     SUBQ.L    #4,A7
  410.             _FrontWindow
  411.     MOVE.L    (A7)+,D0
  412.     MOVE.L    D0,$-8(A2)
  413.     BEQ.S    @exitthis
  414.  
  415.     SUBQ.L    #4,A7
  416.     MOVE.L    D0,-(A7)
  417.             _GetWRefCon
  418.     MOVE.L    (A7)+,A0
  419.  
  420.     BEQ.S    @exitthis
  421.  
  422.     MOVE.L    TaskMenuBarOffset(A0),D0
  423.     BEQ.S    @exitthis
  424.  
  425.     MOVE.L    $-4(A2),MenuDataOffset(A0)
  426.     MOVEQ.L    #-1,D0
  427.     MOVE.L    D0,$-C(A2)
  428.  
  429. @exitthis
  430.     EXG.L    D4,A7
  431.     MOVE.L    $-C(A2),-(A6)
  432.     UNLK    A2
  433.     RTS
  434. END-CODE
  435.  
  436. \ ===== Processing Key Input =============================================
  437. HEX
  438.  
  439. ( : DoKey { | taskptr head tail temp1 temp2 --  }
  440.     CALL FrontWindow
  441.     CALL GetWRefCon -> taskptr
  442.     taskptr
  443.     IF
  444.         taskptr HeadOffset + @    -> head
  445.         taskptr TailOffset + @    -> tail
  446.             
  447.         head 4+ 3F AND        -> temp1   \ Inc the head position
  448.         head FFFFFFC0 AND    -> temp2   \ Get base addr of queue.
  449.         temp1     +> temp2           \ Form new head address.
  450.             
  451.         \ Would the queue overflow if we added a new
  452.         \ character at the new head address ?
  453.         \ (is the queue full?)
  454.         temp2 tail <>
  455.         IF
  456.             \ Store modifiers information in upper
  457.             \ word of local variable.
  458.             EVENT-RECORD Modifiers + W@ ^ temp1 W!
  459.                 
  460.             \ Store the key information in the lower
  461.             \ word of local variable.
  462.             EVENT-RECORD Message + 2+ W@ ^ temp1 2+ W!
  463.                 
  464.             \ Enqueue the key data.
  465.             temp1 head !
  466.                 
  467.             \ Save the new head position.
  468.             temp2 taskptr HeadOffset + !
  469.         ELSE
  470.             5 CALL SysBEEP
  471.         THEN
  472.     ELSE
  473.         5 CALL SysBEEP
  474.     THEN
  475.     ; )
  476. DECIMAL
  477.  
  478. CODE DoKey
  479.     LINK    A2,#$-14
  480.     EXG.L    D4,A7
  481.     SUBQ.L    #8,A7
  482.             _FrontWindow
  483.             _GetWRefCon
  484.     MOVE.L    (A7)+,A0        \ this should be the Taskptr
  485.     EXG.L    D4,A7
  486.     MOVE.L    A0,A0            \ is it zero
  487.     BEQ.S    @beepit
  488.  
  489.     MOVE.L    A0,$-4(A2)        \ save the taskptr
  490.     MOVE.L    HeadOffset(A0),$-8(A2)    \ -> head
  491.     MOVE.L    TailOffset(A0),$-C(A2)    \ -> tail
  492.     
  493.     MOVE.L    $-8(A2),D0        \ head
  494.     ADDQ.L    #4,D0            \ 4+
  495.     MOVEQ.L    #$3F,D1
  496.     AND.L    D1,D0            \ $3F AND
  497.     MOVE.L    D0,$-10(A2)        \ -> temp1
  498.  
  499.     MOVE.L    $-8(A2),D1        \ head
  500.     AND.L    #$FFFFFFC0,D1    \ $FFFFFFC0 AND
  501.     MOVE.L    D1,$-14(A2)        \ -> temp2
  502.     ADD.L    D0,$-14(A2)        \ temp1 +> temp2
  503.  
  504.     \ Would the queue overflow if we added a new
  505.     \ character at the new head address ?
  506.     \ (is the queue full?)
  507.     MOVE.L    $-14(A2),D0        \ temp2
  508.     MOVE.L    $-C(A2),D1        \ tail
  509.     CMP.L    D1,D0
  510.     BEQ.S    @beepit
  511.  
  512.     MOVE.W    "EVENT-RECORD"+Modifiers(A5),$-10(A2)
  513.     MOVE.W    "EVENT-RECORD"+Message+2(A5),$-E(A2)
  514.     MOVE.L    $-8(A2),A0        \ head
  515.     MOVE.L    $-10(A2),(A0)    \ temp1
  516.     MOVE.L    $-4(A2),A0        \ taskPtr
  517.     MOVE.L    $-14(A2),HeadOffset(A0)        \ temp2 taskptr HeadOffset + !
  518.     BRA.S    @exitthis
  519.  
  520. @beepit
  521.     EXG.L    D4,A7
  522.     MOVE.W    #5,-(A7)
  523.             _SysBeep
  524.     EXG.L    D4,A7
  525.  
  526. @exitthis
  527.     UNLK    A2
  528.     RTS
  529. END-CODE
  530.  
  531. ( : DoKeyDown (  -  )
  532.     EVENT-RECORD Modifiers + W@ CommandKeyMask AND
  533.     IF
  534.         \ Handle a command key sequence.
  535.         DoMenuKey 0=
  536.         IF
  537.             DoKey
  538.         THEN
  539.     ELSE
  540.         \ Handle key input.
  541.         DoKey
  542.     THEN
  543.     ; )
  544.     
  545. CODE DoKeyDown
  546.     MOVE.W    "EVENT-RECORD"+Modifiers(A5),D0
  547.     AND.W    #CommandKeyMask,D0
  548.     BEQ.S    @normalKey
  549.  
  550.     JSR        DoMenuKey
  551.     TST.L    (A6)+
  552.     BNE.S    @exitthis
  553.  
  554. @normalKey
  555.     JSR        DoKey
  556.  
  557. @exitthis
  558.     RTS
  559. END-CODE
  560.  
  561. \ ===== Processing Disk Events ===========================================
  562.  
  563. : DoDisk (  -  )
  564.     CALL DILoad
  565.     EVENT-RECORD Message + W@
  566.     IF
  567.         DiskPt
  568.         EVENT-RECORD Message + @
  569.         CALL DIBadMount
  570.         DROP
  571.     THEN
  572.     CALL DIUnload
  573.     ;
  574.  
  575. \ ===== "Vectored" Event Handling Routines ===============================
  576. \ ===== (RUN-UPDATE) =====================================================
  577.  
  578. ( : (RUN-UPDATE) {  | saveport wptr --  }
  579.     EVENT-RECORD Message + @ -> wptr
  580.     ^ saveport CALL GetPort
  581.     wptr       CALL SetPort
  582.     
  583.     wptr CALL BeginUpdate    
  584.         wptr GrowFlagOffset + C@
  585.         IF
  586.             wptr VBarOffset + @
  587.             wptr HBarOffset + @ OR
  588.             0=
  589.             IF
  590.                 \ If there is just a growbox, set pen
  591.                 \ to PatBic mode before redrawing the
  592.                 \ grow icon.  This will cause the grow
  593.                 \ box lines to remain invisible.
  594.                 PatBic CALL PenMode
  595.             THEN
  596.             wptr CALL DrawGrowIcon
  597.             CALL PenNormal            
  598.         THEN
  599.         wptr CALL DrawControls
  600.     wptr     CALL EndUpdate
  601.     saveport CALL SetPort
  602.     ; )
  603.  
  604. CODE (RUN-UPDATE)
  605.     MOVE.L    A2,-(A7)
  606.     MOVE.L    "EVENT-RECORD"+Message(A5),A2
  607.     SUBQ.L    #4,A6
  608.     EXG.L    D4,A7
  609.     MOVE.L    A6,-(A7)
  610.             _GetPort
  611.     MOVE.L    A2,-(A7)
  612.             _SetPort
  613.     MOVE.L    A2,-(A7)
  614.             _BeginUpdate
  615.     MOVE.B    GrowFlagOffset(A2),D0
  616.     BEQ.S    @drawcontrols
  617.     
  618.     MOVE.L    VBarOffset(A2),D0
  619.     OR.L    HBarOffset(A2),D0
  620.     BNE.S    @drawGrowIcon
  621.     
  622.     MOVE.W    #PatBic,-(A7)
  623.             _PenMode
  624.  
  625. @drawGrowIcon
  626.     MOVE.L    A2,-(A7)
  627.             _DrawGrowIcon
  628.             _PenNormal
  629.  
  630. @drawcontrols
  631.     MOVE.L    A2,-(A7)
  632.             _DrawControls
  633.     MOVE.L    A2,-(A7)
  634.             _EndUpdate
  635.     MOVE.L    (A6)+,-(A7)
  636.             _SetPort
  637.     EXG.L    D4,A7
  638.     MOVE.L    (A7)+,A2
  639.     RTS
  640. END-CODE
  641.  
  642. \ ===== (RUN-ACTIVATE) ===================================================
  643.  
  644. : (RUN-ACTIVATE) {  | wptr edith --  } 
  645.     EVENT-RECORD Message + @ -> wptr
  646.  
  647.     \ If Mach2 is around this EditHandle will hold
  648.     \ the handle to the Mach2 "Edit" menu.
  649.     EditHandle @         -> edith
  650.     
  651.     \ Check for an activate event.
  652.     EVENT-RECORD Modifiers + W@ ActivateMask AND
  653.     IF
  654.         \ The edit menu should be disabled when the
  655.         \ Mach window becomes the active window.
  656.         edith
  657.         IF
  658.             wptr
  659.             OPERATOR @ [ 2 TaskWindowPointerOffset + ] LITERAL + @ =
  660.             IF
  661.                 \ 0 means disable entire menu.
  662.                 edith 0 CALL DisableItem
  663.                 OPERATOR @                ( -- OPER.STATUS  )
  664.                 [ 2 TaskMenuBarOffset + ] LITERAL + @ @ 
  665.                 CALL SetMenuBar
  666.                 CALL DrawMenuBar
  667.             THEN
  668.         THEN
  669.     THEN
  670.     wptr CALL SetPort
  671.     wptr GrowFlagOffset + C@
  672.     IF
  673.         wptr VBarOffset + @
  674.         wptr HBarOffset + @ OR
  675.         0=
  676.         IF
  677.             \ If there is just a growbox, set pen
  678.             \ to PatBic mode before redrawing the
  679.             \ grow icon.  This will cause the grow
  680.             \ box lines to remain invisible.
  681.             PatBic CALL PenMode
  682.         THEN
  683.         wptr CALL DrawGrowIcon
  684.         CALL PenNormal            
  685.     THEN ;
  686.  
  687.  
  688. \ ===== "Vectored" Mouse Down Events =====================================
  689. \ ===== (CHECK-CONTROL) ==================================================
  690.  
  691. : RunUserRoutine { wptr taskptr partcode chandle | address  --  }
  692.     taskptr ControlActionOffset + @ -> address
  693.     address
  694.     IF
  695.         partcode
  696.         chandle
  697.         address EXECUTE
  698.     THEN ;
  699.     
  700. : MachTrackControl { wptr taskptr whichcontrol oldpartcode | 
  701.                     point temppartcode  -- flag }
  702.     BEGIN
  703.         CALL StillDown
  704.     WHILE
  705.         ^ point
  706.         CALL GetMouse
  707.         
  708.         whichcontrol
  709.         point
  710.         CALL TestControl -> temppartcode
  711.         
  712.         temppartcode oldpartcode =
  713.         IF
  714.             whichcontrol
  715.             temppartcode
  716.             CALL HiliteControl
  717.             
  718.             wptr taskptr temppartcode whichcontrol
  719.             RunUserRoutine
  720.         ELSE
  721.             whichcontrol
  722.             0
  723.             CALL HiliteControl
  724.         THEN
  725.     REPEAT
  726.     whichcontrol 0 CALL HiliteControl
  727.     
  728.     oldpartcode temppartcode = 
  729.     IF
  730.         temppartcode
  731.     ELSE
  732.         0
  733.     THEN ;
  734.     
  735. : MailData { chandle partcode taskptr --  }
  736.     partcode taskptr ControlDataOffset    + W!
  737.     chandle  taskptr ControlHandleOffset    +  !  ;
  738.  
  739. : (CHECK-CONTROL) { wptr | saveport taskptr localpt whichcontrol partcode
  740.                             flag -- flag }
  741.     0 -> flag
  742.     ^ saveport CALL GetPort
  743.     wptr CALL SetPort
  744.     wptr CALL GetWRefCon -> taskptr
  745.     taskptr
  746.     IF
  747.         \ Look in the window record to see if this window
  748.         \ has any controls.
  749.         wptr controlList + @
  750.         IF
  751.             \ If this window has controls (1) convert the
  752.             \ global mouse point coordinate found in the
  753.             \ EVENT-RECORD to a local window mouse
  754.             \ coordinate 
  755.             EVENT-RECORD Where + @ -> localpt
  756.             ^ localpt CALL GlobalToLocal
  757.             
  758.             \ and (2) use FindControl to determine
  759.             \ which control in the window experienced
  760.             \ the interaction.
  761.             localpt
  762.             wptr
  763.             ^ whichcontrol
  764.             CALL FindControl -> partcode
  765.             
  766.             \ Check the value of the part code returned.
  767.             \ If the mouse was pressed in an invisible,
  768.             \ inactive, or no control, the part code will
  769.             \ be zero.  If the mouse was pressed in a
  770.             \ visible, active control the part code will
  771.             \ be a valid, non-zero part code value.
  772.             partcode
  773.             IF
  774.                 \ The mouse was clicked in a valid
  775.                 \ control, now follow the mouse to
  776.                 \ see if it was released in the control.
  777.                 -1 -> flag
  778.                 partcode InThumb =
  779.                 IF
  780.                     whichcontrol
  781.                     localpt
  782.                     0
  783.                     CALL TrackControl -> partcode
  784.                 ELSE
  785.                     wptr
  786.                     taskptr
  787.                     whichcontrol
  788.                     partcode
  789.                     MachTrackControl -> partcode
  790.                 THEN
  791.                 
  792.                 \ Send the control interaction data
  793.                 \ to the task.
  794.                 whichcontrol partcode taskptr MailData
  795.             THEN
  796.         THEN
  797.     THEN
  798.     saveport CALL SetPort
  799.     flag ;
  800.  
  801.  
  802. \ ===== (RUN-CONTENT) ====================================================
  803.  
  804. : (RUN-CONTENT) {  | wptr taskptr menulist --  }
  805.     \ Is the window clicked in the active window ?
  806.     EVENT-RECORD WhichWindow + @ -> wptr
  807.     CALL FrontWindow  wptr <>
  808.     IF
  809.         \ Initialize local variable.
  810.         EmptyMenuBar @ -> menulist
  811.         
  812.         \ This window was not active, select it.
  813.         wptr CALL SelectWindow
  814.         
  815.         \ If the window just selected has a
  816.         \ menubar, display the menubar.
  817.         \ Otherwise display and empty menubar.
  818.         wptr CALL GetWRefCon -> taskptr
  819.         taskptr
  820.         IF
  821.             \ Check the TaskMenuBar field of the
  822.             \ task's user variable area.  A non-zero
  823.             \ value found there should be the address
  824.             \ where the MenuList handle for the task's
  825.             \ menubar is stored.
  826.             taskptr TaskMenubarOffset + @
  827.             ?DUP
  828.             IF
  829.                 \ Display the task's custom menubar.
  830.                 @ -> menulist
  831.             THEN
  832.         THEN
  833.         menulist CALL SetMenuBar
  834.         CALL DrawMenuBar
  835.     ELSE
  836.         wptr (CHECK-CONTROL) DROP
  837.     THEN ;
  838.  
  839.  
  840. \ ===== (RUN-DRAG) =======================================================
  841.  
  842. : (RUN-DRAG) {  | wptr taskptr --  } 
  843.     \ Check to see if the window whose drag region was clicked in
  844.     \ is the current active window
  845.     EVENT-RECORD WhichWindow + @ -> wptr
  846.     
  847.     CALL FrontWindow
  848.     wptr
  849.     <>
  850.     IF
  851.         \ If the window clicked in was not the active window
  852.         \ first check to see if the command key was held down
  853.         \ when the click occurred.  If it was, we will not
  854.         \ activate the window.
  855.         EVENT-RECORD Modifiers +  W@  CommandKeyMask  AND
  856.         0=
  857.         IF
  858.             \ The command key was not down,
  859.             \ select the window.
  860.             wptr CALL SelectWindow
  861.             
  862.             \ If the window just selected has a
  863.             \ menubar, display the menubar.
  864.             \ Otherwise display and empty menubar.
  865.             wptr CALL GetWRefCon -> taskptr
  866.             taskptr
  867.             IF
  868.                 \ Check the TaskMenuBar field of the
  869.                 \ task's user variable area.  A non-zero
  870.                 \ value found there should be the address
  871.                 \ where the MenuList handle for the task's
  872.                 \ menubar is stored.
  873.                 taskptr TaskMenubarOffset + @
  874.                 DUP
  875.                 IF
  876.                     \ Display the task's custom menubar.
  877.                     @ CALL SetMenubar
  878.                 ELSE
  879.                     \ Display an empty menubar.
  880.                     DROP  ( the zero  TaskMenuBar)
  881.                     EmptyMenubar @ CALL SetMenubar
  882.                 THEN
  883.                 CALL DrawMenuBar
  884.             THEN
  885.         THEN
  886.     THEN 
  887.     wptr            \ Windowpointer for window to drag.
  888.     EVENT-RECORD Where + @    \ Mouse location in global coordinates.
  889.     ScreenRect        \ Coordinates of this screen.
  890.     CALL DragWindow  ;
  891.  
  892.  
  893. \ ===== (RUN-GROWBOX) ====================================================
  894.  
  895. : RedrawHVBars { wptr | vbarh hbarh -- }
  896.     wptr VBarOffset + @ -> vbarh
  897.     wptr HBarOffset + @ -> hbarh
  898.     
  899.     vbarh
  900.     IF
  901.         \ Hide the control before we redraw it.
  902.         vbarh CALL HideControl
  903.         
  904.         \ Move the control to its new position.
  905.         vbarh
  906.         wptr portRect + 6 + W@ 15 -    \ Horizontal destination.
  907.         wptr portRect + W@ 1-        \ Vertical destination.
  908.         CALL MoveControl
  909.         
  910.         \ Resize the control
  911.         vbarh
  912.         16                \ New control width.
  913.         wptr portRect + 4+ W@ 13 -    \ New control height.
  914.         CALL SizeControl
  915.         
  916.         \ Now tell the window manager that the control
  917.         \ area has already been redrawn
  918.         vbarh @ ctrlRectOffset +
  919.         CALL ValidRect
  920.         
  921.         \ Now the control can be made visible again.
  922.         vbarh CALL ShowControl
  923.     THEN
  924.         
  925.     hbarh
  926.     IF
  927.         hbarh CALL HideControl
  928.  
  929.         hbarh
  930.         wptr portRect + 2+ W@ 1-    \ Horiz. dest.
  931.         wptr portRect + 4+ W@ 15 -    \ Vert. dest.
  932.         CALL MoveControl
  933.  
  934.         hbarh
  935.         wptr portRect + 6 + W@ 13 -    \ New width.
  936.         16                \ New height.
  937.         CALL SizeControl
  938.  
  939.         hbarh @ ctrlRectOffset +
  940.         CALL ValidRect
  941.  
  942.         hbarh CALL ShowControl
  943.     THEN ;
  944.  
  945. : EraseEdges { wptr | oldbot oldright rightbot lefttop --  }
  946.     ^ lefttop ^ rightbot 2DROP
  947.     wptr portRect + 4+ W@ -> oldbot
  948.     wptr portRect + 6 + w@ -> oldright
  949.     
  950.     \ First, erase bottom edge of window.
  951.     oldbot 16 -    ^ lefttop    W!    \ Top of rect to be erased.
  952.     0        ^ lefttop 2+    W!    \ Left of rect to be erased.
  953.     oldbot        ^ rightbot    W!    \ Bot. of rect to be erased.
  954.     oldright    ^ rightbot 2+    W!    \ Right of rect to be erased.
  955.     ^ lefttop CALL EraseRect
  956.     ^ lefttop CALL InvalRect
  957.     
  958.     \ Next, erase right edge of window.
  959.     0        ^ lefttop    W!
  960.     oldright 16 -    ^ lefttop 2+    W!
  961.     oldbot        ^ rightbot    W!
  962.     oldright    ^ rightbot 2+    W!
  963.     ^ lefttop CALL EraseRect
  964.     ^ lefttop CALL InvalRect  ;
  965.  
  966. : (RUN-GROWBOX) {  | wptr wrect oldheight 
  967.             rightbot lefttop newwidth newheight --  }
  968.     EVENT-RECORD WhichWindow + @ -> wptr
  969.     CALL FrontWindow  wptr  =
  970.     IF
  971.         wptr portRect +            -> wrect
  972.         wrect 4+ W@    wrect W@ -    -> oldheight
  973.         ScreenRect ^ lefttop 8 CMOVE
  974.         
  975.         wptr CALL SetPort
  976.         wptr
  977.         EVENT-RECORD Where + @
  978.         ^ lefttop
  979.         CALL GrowWindow     -> newwidth
  980.         ^ newwidth W@    -> newheight
  981.         0 ^ newwidth W!
  982.         
  983.         \ Is the window shorter ?
  984.         newheight oldheight <
  985.         IF
  986.             wrect CALL InvalRect
  987.             wrect CALL EraseRect
  988.         THEN
  989.         
  990.         wptr EraseEdges
  991.         wptr newwidth newheight -1 CALL SizeWindow
  992.         wptr EraseEdges
  993.         
  994.         wptr RedrawHVBars
  995.     THEN ;
  996.  
  997.  
  998. \ ===== (RUN-CLOSEBOX) ===================================================
  999.  
  1000. : (RUN-CLOSEBOX) {  | wptr menuhandle taskptr --  }
  1001.     \ If the window is not the active window, leave.
  1002.     EVENT-RECORD WhichWindow + @ -> wptr
  1003.     CALL FrontWindow  wptr =
  1004.     IF
  1005.         \ Initialize the contents of the menulist local variable.
  1006.         EmptyMenubar @ -> menuhandle
  1007.         
  1008.         \ Follow the mouse.
  1009.         \ If it is not released inside of the close box, leave.
  1010.         wptr
  1011.         EVENT-RECORD Where + @
  1012.         CALL TrackGoAway
  1013.         IF
  1014.             \ Hide the window and get the window
  1015.             \ pointer for the window immediately behind
  1016.             \ the window just closed, if any.
  1017.             wptr CALL HideWindow
  1018.             CALL FrontWindow -> wptr
  1019.             wptr
  1020.             IF
  1021.                 \ If the window just uncovered has a
  1022.                 \ menubar, display the menubar.
  1023.                 \ Otherwise display and empty menubar.
  1024.                 wptr CALL GetWRefCon -> taskptr
  1025.                 taskptr
  1026.                 IF
  1027.                     \ Check the TaskMenuBar field of 
  1028.                     \ the task's user variable area.
  1029.                     \ A non-zero value found there
  1030.                     \ should be the address where the
  1031.                     \ MenuList handle for the task's
  1032.                     \ menubar is stored.
  1033.                     taskptr TaskMenubarOffset + @
  1034.                     ?DUP
  1035.                     IF
  1036.                         \ Display the task's 
  1037.                         \ custom menubar.
  1038.                         @ -> menuhandle
  1039.                     THEN
  1040.                 THEN
  1041.             THEN    
  1042.             menuhandle CALL SetMenuBar
  1043.             CALL DrawMenubar            
  1044.         THEN
  1045.     THEN  ;
  1046.  
  1047.  
  1048. \ ===== (RUN-ZOOMIN) =====================================================
  1049. \ ===== (RUN-ZOOMOUT) ====================================================
  1050.  
  1051. : DoZoom { findcode | wptr taskptr  --  }
  1052.     EVENT-RECORD WhichWindow + @ -> wptr
  1053.     CALL FrontWindow wptr =
  1054.     IF
  1055.         wptr CALL SetPort
  1056.         
  1057.         wptr
  1058.         EVENT-RECORD Where + @
  1059.         findcode
  1060.         CALL TrackBox
  1061.         IF
  1062.             wptr EraseEdges
  1063.             
  1064.             wptr findcode -1 CALL ZoomWindow
  1065.             
  1066.             wptr EraseEdges
  1067.             wptr RedrawHVBars
  1068.         THEN
  1069.     THEN ;
  1070.     
  1071. : (RUN-ZOOMIN) (  -  )
  1072.     InZoomIn DoZoom ;
  1073.     
  1074. : (RUN-ZOOMOUT) (  -  )
  1075.     InZoomOut DoZoom ;
  1076.  
  1077.  
  1078. \ ===== MouseDown Event Dispatch Routine =================================
  1079.  
  1080. : DoMouseDown {  | findcode window taskptr  -- }
  1081.     EVENT-RECORD Where + @
  1082.     ^ window
  1083.     CALL FindWindow -> findcode
  1084.  
  1085.     \ If click is in the menubar, we must specifically check for
  1086.     \ the frontwindow.
  1087.     findcode InMenuBar =
  1088.     IF
  1089.         CALL FrontWindow -> window
  1090.     THEN
  1091.  
  1092.     \ If click is in the growbox area, make sure the window has a 
  1093.     \ growbox.  If it doesn't, turn click into an in-content code.
  1094.     findcode InGrow =
  1095.     IF
  1096.         window GrowFlagOffset + C@ 0=
  1097.         IF
  1098.             InContent -> findcode
  1099.         THEN
  1100.     THEN
  1101.     
  1102.     \ We will only process this event if we have a valid windowpointer.
  1103.     window
  1104.     IF
  1105.         window EVENT-RECORD WhichWindow + !    
  1106.         window CALL GetWRefCon -> taskptr
  1107.         taskptr
  1108.         IF
  1109.             findcode
  1110.             CASE
  1111.                 InContent
  1112.                 OF taskptr ContentOffset + @ EXECUTE
  1113.                 ENDOF
  1114.  
  1115.                 InDrag
  1116.                 OF taskptr DragOffset + @ EXECUTE
  1117.                 ENDOF
  1118.  
  1119.                 InGrow
  1120.                 OF taskptr GrowOffset + @ EXECUTE
  1121.                 ENDOF
  1122.  
  1123.                 InGoAway
  1124.                 OF taskptr GoAwayOffset + @ EXECUTE
  1125.                 ENDOF
  1126.  
  1127.                 InZoomIn
  1128.                 OF taskptr ZoomInOffset + @ EXECUTE    
  1129.                 ENDOF
  1130.  
  1131.                 InZoomOut
  1132.                 OF taskptr ZoomOutOffset + @ EXECUTE
  1133.                 ENDOF
  1134.  
  1135.                 InSysWindow    OF Run-System    ENDOF
  1136.                 InMenuBar    OF Run-Menubar    ENDOF
  1137.                 InDesk        OF Run-Desk    ENDOF
  1138.             ENDCASE
  1139.         ELSE
  1140.             findcode
  1141.             CASE
  1142.                 InContent     OF (RUN-CONTENT)    ENDOF
  1143.                 InDrag        OF (RUN-DRAG)        ENDOF
  1144.                 InGrow        OF (RUN-GROWBOX)    ENDOF
  1145.                 InGoAway    OF (RUN-CLOSEBOX)    ENDOF
  1146.                 InZoomIn    OF (RUN-ZOOMIN)        ENDOF
  1147.                 InZoomOut    OF (RUN-ZOOMOUT)    ENDOF
  1148.     
  1149.                 InSysWindow    OF Run-System    ENDOF
  1150.                 InMenuBar    OF Run-Menubar    ENDOF
  1151.                 InDesk        OF Run-Desk    ENDOF
  1152.             ENDCASE
  1153.         THEN
  1154.     THEN  ;
  1155.  
  1156.  
  1157. \ ===== Modeless Dialog Event Dispatch Routine ===========================
  1158. \ ===== (HandleDialog) ===================================================
  1159.  
  1160. : (HandleDialog) {  | thedialog itemhit wptr taskptr --  }
  1161. \ This routine is called if a modeless dialog event has occurred.
  1162. \ We know it is a modeless dialog event because a modal dialog
  1163. \ would use its own event loop.
  1164.     \ If the event involves an enabled dialog item, DialogSelect
  1165.     \ will return TRUE and will return the dialog handle and
  1166.     \ the item number affected in the specified local variables.
  1167.     EVENT-RECORD   ^ thedialog   ^ itemhit  CALL DialogSelect
  1168.     IF
  1169.         \ Which terminal task is using this modeless dialog ?
  1170.         CALL FrontWindow -> wptr
  1171.         wptr
  1172.         IF
  1173.             wptr CALL GetWRefCon -> taskptr
  1174.             taskptr
  1175.             IF
  1176.                 \ If we were able to find the taskptr
  1177.                 \ we can place the important information
  1178.                 \ about the modeless dialog interaction
  1179.                 \ in the appropriate user variable fields
  1180.                 \ of the task's user variable area.
  1181.                 
  1182.                 \ The item number is a word length value.
  1183.                 \ It will be returned in the upper 2 bytes
  1184.                 \ of the local variable.
  1185.                 ^ itemhit W@
  1186.                 taskptr DialogDataOffset +
  1187.                 W!
  1188.                 
  1189.                 thedialog
  1190.                 taskptr DialogHandleOffset +
  1191.                 !
  1192.             THEN
  1193.         THEN
  1194.     THEN ;
  1195.  
  1196.  
  1197. \ ===== Event Dispatching Routines =======================================
  1198.  
  1199. : HandleDialog  {  | taskptr wptr eventWhat exitflag --  }
  1200. \ If it's a dialog event (and not an activate or update), the Message field of 
  1201. \ the EVENT-RECORD will not contain a window pointer, we must 
  1202. \ specifically ask for the window pointer.
  1203.     EVENT-RECORD What +  W@  -> eventWhat
  1204.     eventWhat ActivateEvent =   eventWhat UpdateEvent =  OR
  1205.     IF
  1206.         EVENT-RECORD Message +  @  -> wptr
  1207.     ELSE 
  1208.         CALL FrontWindow  -> wptr
  1209.     THEN   
  1210.     BEGIN
  1211.         wptr WindowKind + W@
  1212.         dialogKind =
  1213.         IF
  1214.             wptr CALL GetWRefCon -> taskptr
  1215.             taskptr
  1216.             IF
  1217.                 ( let the task call DialogSelect using it's own routine
  1218.                   in DialogHook )
  1219.                 taskptr DialogHookOffset + @ EXECUTE
  1220.             ELSE
  1221.                 ( do the default dialog handling routine )
  1222.                 (HandleDialog)
  1223.             THEN
  1224.             .TRUE. -> exitflag
  1225.         ELSE
  1226.             wptr NextWindow + @ -> wptr
  1227.             wptr 0=
  1228.             IF
  1229.                 ( we have run out of windows, call the default
  1230.                   routine and exit. )
  1231.                 .TRUE. -> exitflag
  1232.                 (HandleDialog)
  1233.             ELSE
  1234.                 .FALSE. -> exitflag
  1235.             THEN
  1236.         THEN
  1237.  
  1238.         exitflag
  1239.     UNTIL
  1240.     ;
  1241.  
  1242. : DoUpdate {  | taskptr --  }
  1243.     EVENT-RECORD Message + @ CALL GetWRefCon -> taskptr
  1244.     taskptr
  1245.     IF
  1246.         taskptr UpdateOffset + @ EXECUTE
  1247.     ELSE
  1248.         (RUN-UPDATE)
  1249.     THEN  ;
  1250.     
  1251. : DoActivate {  | taskptr --  }
  1252.     EVENT-RECORD Message + @ CALL GetWRefCon -> taskptr
  1253.     taskptr
  1254.     IF
  1255.         taskptr ActivateOffset + @ EXECUTE
  1256.     ELSE
  1257.         (RUN-ACTIVATE)
  1258.     THEN  ;
  1259.     
  1260. : NextEvent (  -  )  ;
  1261.  
  1262.  
  1263. \ ===== MultiFinder Event Handling Code =================================
  1264.  
  1265. CODE Next.Event
  1266.     LEA        2(PC),A0    \ the actual offset will be filled in later
  1267.     MOVE.L    A0,-(A7)
  1268.     RTS
  1269. END-CODE
  1270.  
  1271. : GetNextEvent
  1272.     CALL SystemTask
  1273.     EveryEvent EVENT-RECORD CALL GetNextEvent
  1274.     ;
  1275.  
  1276. : WaitNextEvent
  1277.     { | mysleep -- result }
  1278.     EVENT-RECORD W@  0=
  1279.     IF
  1280.         ( the last event was a Null Event, so get another - 
  1281.           use the value in #.of.Null.Events to set the 
  1282.           sleep parameter)
  1283.         #.of.Null.Events W@  DUP 
  1284.         L_EXT -1 + ABS #.of.Null.Events W!    ( toggle between zero and one )
  1285.     ELSE
  1286.         ( the event is non-null, so set the sleep parameter to zero,
  1287.           and reset the #.of.Null.Events parameter )
  1288.         0 DUP #.of.Null.Events W!
  1289.     THEN
  1290.     -> mysleep
  1291.     EveryEvent EVENT-RECORD mysleep 0 CALL WaitNextEvent
  1292.     ;
  1293.  
  1294. : All.Events
  1295.     Next.Event.proc @ EXECUTE    \ get routine from USER variable
  1296.     ;
  1297.  
  1298. ( Now we need the startup code )
  1299.  
  1300. : First.Event
  1301.     ( This routine establishes whether MultiFinder is running
  1302.       and sets the correct Event get vector )
  1303.  
  1304.     MACH2.flags @ $08 AND 0=
  1305.     IF
  1306.         ( MultiFinder doesn't exist )
  1307.         ['] GetNextEvent
  1308.     ELSE
  1309.         0 #.of.Null.Events W!    ( set the null events toggle )
  1310.         ['] WaitNextEvent
  1311.     THEN
  1312.     Next.Event.proc !        ( stored in USER variable )
  1313.  
  1314.     ( now set the vector execution path )
  1315.     ['] All.Events ['] Next.Event 2+ -
  1316.     ['] Next.Event 2+ W!
  1317.     ( and call it )
  1318.     Next.Event
  1319.     ;
  1320.  
  1321. ' First.Event 
  1322. ' Next.Event 2+ -
  1323. ' Next.Event 2+ W!
  1324.  
  1325. ( Now set up here for Suspend/Resume Events )
  1326.  
  1327. : do.Suspend.Resume
  1328.     { | taskptr windowPtr the.windowKind -- }
  1329.     EVENT-RECORD Message + @ Resume AND
  1330.     fgnd.bkgnd W!
  1331.  
  1332.     CALL FrontWindow    -> windowPtr
  1333.     windowPtr
  1334.     IF
  1335.         ( first simulate an activate/deactivate event )
  1336.         ActivateEvent EVENT-RECORD W!
  1337.         windowPtr EVENT-RECORD Message + !
  1338.         fgnd.bkgnd W@ EVENT-RECORD Modifiers + W!
  1339.  
  1340.         windowPtr windowKind + W@ L_EXT -> the.windowKind
  1341.  
  1342.         windowPtr CALL GetWRefCon -> taskptr
  1343.  
  1344.         the.windowKind 7 >
  1345.         taskptr
  1346.         AND
  1347.         IF
  1348.             \ it is definitely a program window
  1349.             taskptr ActivateOffset + @ EXECUTE
  1350.         ELSE
  1351.             the.windowKind 0<
  1352.             IF
  1353.                 \ it is a desk accessory
  1354.                 EVENT-RECORD CALL SystemEvent
  1355.                 DROP ( the result )
  1356.             ELSE
  1357.                 \ the only thing left is a dialog or alert, and it should
  1358.                 \ be modeless
  1359.                 HandleDialog
  1360.             THEN
  1361.         THEN
  1362.     THEN
  1363.     ;
  1364.   
  1365. \ ===== High-Level Events ================================================
  1366.  
  1367. CODE do.AEvent
  1368.     MOVEM.L    D5-D7/A2/A3/A7,-(A6)    \ push the task State because the
  1369.     MOVE.L    A6,8(A4)                \ AE handler always switches back in
  1370.     EXG.L    D4,A7                    \ switch to the trapStack
  1371.     SUBQ.L    #2,A7                    \ space for result
  1372.     LEA        "EVENT-RECORD",A0        \ get the Event record
  1373.     MOVE.L    A0,-(A7)                \ push on the stack
  1374.     MOVE.W    #$021B,D0                \ selector for trap
  1375.             _AEProcessAppleEvent
  1376.     ADDQ.L    #2,A7                    \ drop the result, because there
  1377.     EXG.L    D4,A7                    \ is nobody to pass it to
  1378.     MOVE.L    8(A4),A6                \ restore the stack
  1379.     MOVEM.L    (A6)+,D5-D7/A2/A3/A7    \ restore the registers
  1380.     RTS
  1381. END-CODE
  1382.  
  1383. : Do.HLE
  1384.     \ CALL Debugger
  1385.     HLE.Handler @ ?DUP 0= NOT
  1386.     IF
  1387.         0 SWAP EXECUTE ( result -- result )    
  1388.         ( result is zero if HLE.handler couldn't handle this event,
  1389.           and non-zero if it did )
  1390.         0=
  1391.         IF
  1392.             do.AEvent
  1393.         THEN
  1394.     ELSE
  1395.         do.AEvent
  1396.     THEN
  1397.     PAUSE
  1398.     ;
  1399.  
  1400. \ ===== (EVENT-TABLE =====================================================
  1401.  
  1402. CREATE (EVENT-TABLE)
  1403.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (0)    Null event.
  1404.     DC.L    "DoMouseDown"-"(EVENT-TABLE)"-4            \ (1)    Mouse down event.
  1405.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (2)    Mouse up event.
  1406.     DC.L    "DoKeyDown"-"(EVENT-TABLE)"-4            \ (3)    Key down event.
  1407.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (4)    Key up event.
  1408.     DC.L    "DoKeyDown"-"(EVENT-TABLE)"-4            \ (5)    Auto key event.
  1409.     DC.L    "DoUpdate"-"(EVENT-TABLE)"-4            \ (6)    Update event.
  1410.     DC.L    "DoDisk"-"(EVENT-TABLE)"-4                \ (7)    Disk event.
  1411.     DC.L    "DoActivate"-"(EVENT-TABLE)"-4            \ (8)    Activate event.
  1412.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (9)    Not used ?
  1413.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (10)    Network event.
  1414.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (11)    Driver event.
  1415.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (12)    Appl-defined event #1.
  1416.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (13)    Appl-defined event #2.
  1417.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (14)    Appl-defined event #3.
  1418.     DC.L    "do.Suspend.Resume"-"(EVENT-TABLE)"-4    \ (15)    Suspend/Resume Events.
  1419.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (16)    Not used ?
  1420.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (17)    Not used ?
  1421.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (18)    Not used ?
  1422.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (19)    Not used ?
  1423.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (20)    Not used ?
  1424.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (21)    Not used ?
  1425.     DC.L    NextEvent-"(EVENT-TABLE)"-4                \ (22)    Not used ?
  1426.     DC.L    "Do.HLE"-"(EVENT-TABLE)"-4                \ (23)    High-level event
  1427.  
  1428.  
  1429. ( : HandleEvent {  | eventcode baseaddr --  }
  1430.     EVENT-RECORD What + W@    -> eventcode
  1431.     (EVENT-TABLE)        -> baseaddr
  1432.     baseaddr            \ Base address.
  1433.     eventcode 4*        \ Index into event table.
  1434.     + @                    \ Offset to routine.
  1435.     baseaddr +            \ Address of routine.
  1436.     EXECUTE
  1437.     ; )
  1438.     
  1439. CODE HandleEvent
  1440.     MOVE.W    "EVENT-RECORD",D0
  1441.     ASL.W    #2,D0                    \ multiply event code by 4
  1442.     LEA        "(EVENT-TABLE)"+4,A0    \ get base address of event table entries
  1443.     MOVE.L    (A0,D0.W),D0            \ get offset from base of event table
  1444.     JSR        (A0,D0.L)                \ add offset to event table base and JSR to it
  1445.     RTS
  1446. END-CODE
  1447.  
  1448. \ ===== The Main Loop ====================================================
  1449.  
  1450. : DialogEvent? (  -  f  )
  1451.     \ If the event is a dialog event which should be handled
  1452.     \ by our application (usually be being passed to DialogSelect),
  1453.     \ IsDialogEvent will return a true flag.  If the event
  1454.     \ should be handled as a normal, non-dialog event, false
  1455.     \ will be returned.
  1456.     EVENT-RECORD CALL IsDialogEvent ;
  1457.         
  1458. \ ===== (IOTASK) =========================================================
  1459.     
  1460. : (IOTask) {  | dialogflag eventflag --  }
  1461.     BEGIN
  1462.             BEGIN
  1463.                 Next.Event        -> eventflag
  1464.                 DialogEvent?    -> dialogflag
  1465.  
  1466.                 dialogflag
  1467.                 IF
  1468.                     HandleDialog
  1469.                 ELSE
  1470.                     eventflag
  1471.                     IF
  1472.                         HandleEvent
  1473.                     THEN
  1474.                 THEN
  1475.             eventflag 0=
  1476.             UNTIL
  1477.         PAUSE
  1478.     AGAIN ;
  1479.         
  1480. ONLY FORTH
  1481.  
  1482. NEW-IOTASK
  1483.  
  1484. \ ===== END OF FILE ======================================================
  1485. \ ========================================================================
  1486. \ ========================================================================
  1487.